home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / oop.swg / 0034_TVision Extension.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  3.3 KB  |  142 lines
  1. {
  2. >try using resource files with TurboVision. When opening a resource file with
  3. >extension EXE, TV will append it to the file during write operations.
  4. >I did it already for registration stuff and it works fine.
  5.  
  6. The trouble with this approach is that each write operation appends a
  7. record, it doesn change the existing one.  For something you do only once
  8. like registration, that's okay, but for config changes, you need to do
  9. something to pack the records.  With Resource files that's complicated, but
  10. possible.  Here's the unit I use to do it.
  11. }
  12.  
  13. unit resources;
  14.  
  15. { Unit to provide extra functions to TVision TResourceFiles }
  16.  
  17. interface
  18.  
  19. uses
  20.   objects;
  21.  
  22. type
  23.   PPackableResource = ^TPackableResource;
  24.   TPackableResource = object(TResourceFile)
  25.     function pack : boolean;
  26.     { Packs the resource file by reading all resources and rewriting them to
  27.       the stream.  Returns false if it fails. }
  28.   end;
  29.  
  30. implementation
  31.  
  32. type
  33.   { Type here to get at the secret fields of the TResourceFile }
  34.   TResourceSecrets = object(TObject)
  35.     Stream   : PStream;
  36.     Modified : Boolean;
  37.     BasePos  : Longint;
  38.     IndexPos : Longint;
  39.     Index    : TResourceCollection;
  40.   end;
  41.  
  42.   PNamedItem = ^TNamedItem;
  43.   TNamedItem = object(TObject)
  44.     Item : PObject;
  45.     Name : PString;
  46.     destructor done; virtual;
  47.   end;
  48.  
  49. destructor TNamedItem.done;
  50. begin
  51.   DisposeStr(Name);
  52.   inherited done;
  53. end;
  54.  
  55. procedure Deletechars(var S : TStream; count : Longint);
  56. { Deletes the given number of characters from the stream }
  57. var
  58.   copy    : longint;
  59.   buffer  : array [1..1024] of byte;
  60.   bufsize : word;
  61.   pos     : longint;
  62. begin
  63.   pos     := S.GetPos;
  64.   copy    := S.GetSize - pos - count;
  65.   bufsize := sizeof(buffer);
  66.  
  67.   while copy > 0 do
  68.   begin
  69.     if copy < sizeof(buffer) then
  70.       bufsize := copy;
  71.     S.Seek(pos + count);
  72.     S.Read(Buffer, bufsize);
  73.     S.Seek(pos);
  74.     S.write(Buffer, bufsize);
  75.     inc(pos, bufsize);
  76.     dec(copy, bufsize);
  77.   end;
  78.   S.Truncate;
  79. end;
  80.  
  81. function TPackableResource.Pack : boolean;
  82. var
  83.   contents  : TCollection;
  84.   i         : integer;
  85.   item      : PObject;
  86.   nameditem : PNamedItem;
  87.   OldSize   : longint;
  88. begin
  89.   Flush;
  90.   pack := false;   { Assume failure }
  91.   if Stream^.status <> stOk then
  92.     exit;
  93.  
  94.   { First, make a copy of all the contents in memory }
  95.  
  96.   contents.init(Count, 10);
  97.   for i := 0 to pred(Count) do
  98.   begin
  99.     item := Get(KeyAt(i));
  100.     New(NamedItem, init);
  101.     if (NamedItem = nil) or (item = nil) then
  102.     begin
  103.       contents.done;
  104.       exit;
  105.     end;
  106.     NamedItem^.item := item;
  107.     NamedItem^.name := Newstr(Keyat(i));
  108.     contents.atinsert(i, nameditem);
  109.   end;
  110.  
  111.   { Now, remove all traces of the original. }
  112.  
  113.   with TResourceSecrets(Self) do
  114.   begin
  115.     Stream^.Seek(BasePos + 4);
  116.     Stream^.Read(OldSize, Sizeof(OldSize));
  117.     Stream^.Seek(BasePos);
  118.     DeleteChars(Stream^, OldSize + 8);
  119.   end;
  120.  
  121.   { Now, close down and restart }
  122.   TResourceSecrets(Self).Index.Done;
  123.   Stream^.Seek(0);
  124.   inherited init(Stream);
  125.  
  126.   { Now rewrite all those saved objects. }
  127.   for i := 0 to pred(contents.count) do
  128.   begin
  129.     nameditem := PNamedItem(contents.At(i));
  130.     Put(nameditem^.item, nameditem^.name^);
  131.   end;
  132.  
  133.   { Get rid of the copies from memory }
  134.   contents.done;
  135.  
  136.   if Stream^.Status = stOk then
  137.     pack := true;
  138. end;
  139.  
  140. end.
  141.  
  142.